\ An implementation of local variables.
\ Not ANS compatible.
\ Local variables are declared with the word LOCALS{ followed by a list
\ of variable names, followed by a closing }
\ For example:
\   TEST ( -- ) locals{ a b c } ... ... ... ;
\ The local variables are initialised to 0 upon creation.
\
\ Locals are referenced in code with their names.
\ Locals may be written to with SET and +SET. E.g.
\ : TEST ( x y z -- ) locals{ a b c } set c   set b   set a ;
\ The above example initialises the local variables a, b and c from the
\ data on the data stack. Z goes to c, y to b, and x to a.
\
\ Here is another example:
\ : TEST ( x y z -- z(x+y) )
\   locals{ x y z } set z  set y  set x
\   x y + z * ;
\
\ Where recursion is used with a definition that contains locals, each
\ instance of the definition shall inherit its own set of new locals.
\ These will be automatically de-allocated when the recursion un-winds.
\ Locals consume no dictionary space at all. Their names are temporarily
\ hashed during compilation only. After that their names are not required.
\ The hash table is set to the end of RAM (see dictAddr). There is
\ room for 14 locals per definition as currently set.
\ The locals stack sits immediately above the hash table and grows
\ towards lower memory addresses (the hash table grows to higher addresses).
\
\ During execution, locals add very little overhead: 1 call to allocate
\ the appropriate number of local-stack cells at the beginning of a colon
\ definition, and a similar call to de-allocate at the end of a colon
\ definition.
\ References to locals are compiled as literals representing an offset
\ into the locals stack, plus a call to @local

0 value locals?             \ true if a colon-def has locals
0 value localCount          \ number of locals in a colon def
0 value localOffset
$FFE0 VALUE dictAddr        \ address of start of local dictionary
$A006 @ VALUE _FIND         \ save contents of FIND vector
dictAddr VALUE _LS          \ top of local stack pointer
\ note: the locals stack and the locals dictionary grow away from each
\ other. There is a pre-decrement on local stack operations, therefore
\ it is safe to set the locals stack to the same address as the locals
\ dictionary, as they grow away from each other.

: (freeLocals) ( n -- ) \ runtime code to de-allocate n locals
    CELLS +TO _LS ;

: freeLocals ( n -- ) \ compile runtime code to free n locals
    COMPILE LIT , COMPILE (freeLocals) 
    FALSE TO locals? ;

: (allotLocals) ( n -- ) \ runtime code to allot n locals on locals stack
    \ stack grows towards lower memory addresses
    CELLS DUP NEGATE +TO _LS
    _LS SWAP 0 FILL ( intialise n locals to 0) ;

: allotLocals ( n -- ) \ compile run-time code to allot n locals
    COMPILE LIT ,   COMPILE (allotLocals) 
    TRUE TO locals? ;

: >HASH ( c-addr len -- u)
  \ hashes a string using the CRC-16 algorithm
  $FFFF             \ intial CRC16
  -ROT              \ move it out of the way
  OVER + SWAP DO    \ for each byte in the string
    I C@ XOR        \ xor with CRC16
    8 0 DO          \ for 8 bits in the byte
        DUP 1 AND   \ note the LSB prior to shift
        SWAP 1 >>   \ shift the CRC16
        SWAP IF 
            $A001 XOR \ if LSB was 1 then apply polynomial
        THEN  
    LOOP
  LOOP ;

: (LOCAL) ( addr len -- )
    ?DUP IF \ is a local. Add to fleeting locals dictionary:
        >HASH               \ hash the variable name
        dictAddr localCount CELLS + ! \ store hash in local dictionary
        1 +TO localCount    \ increment number of locals
    ELSE \ end of locals list
        DROP
        localCount allotLocals
    THEN ;

: LOCALS{ ( "name...name }" -- 
    0 TO localCount
    BEGIN
        BL WORD  OVER C@
        ASCII } - OVER 1 - OR
    WHILE               \ while | character not detected
        (LOCAL)         \ add local variable to locals dictionary
    REPEAT
    2DROP  0 0 (LOCAL)  \ end local dictionary processing
; IMMEDIATE

: @local ( index -- n )
    \ fetch a local from the local stack
    _LS + @ ;

: compileLocal ( -- )
    COMPILE LIT  localOffset 1- CELLS ,  COMPILE @local ;

: findLocal ( addr len - offset+1|0)
    \ search locals dictionary for word and return offset into
    \ locals stack+1 if found or 0 if not found
    >HASH 0 SWAP
    localCount 0 DO
        dictAddr I CELLS + @ OVER = IF
            SWAP DROP I 1+ SWAP LEAVE
        THEN
    LOOP  DROP 
    DUP TO localOffset ;

: localNotFound ( --)
    CR ." Error: Local not found."
    FALSE to locals? ABORT ;
    
: (SET) ( value offset -- ) 
    \ at runtime, set a local variable to to value value
    _LS + ! ;

: (+SET) ( value offset -- ) 
    \ at runtime add a value to a local variable
    _LS + +! ;

: doSET ( xt "local" value -- )
    BL WORD findLocal IF
        COMPILE LIT localOffset 1- CELLS ,  ,
    ELSE
        localNotFound
    THEN ;
   
: SET  ( "local" value --) \ write the value to the local variable
    ['] (SET) doSet ; IMMEDIATE
    
: +SET ( "local" value --) \ add the value to the local variable
    ['] (+SET) doSet ; IMMEDIATE

: ; locals? IF localCount freeLocals THEN [COMPILE] ; ; IMMEDIATE

0 value _addr   0 value _len
: FIND ( addr len -- cfa flag )
    2DUP  TO _len  TO _addr
    _FIND EXECUTE DUP 0= IF
        STATE @ IF
            locals? IF
                2DROP _addr _len findLocal IF
                    ['] compileLocal 1
                ELSE
                    0 0
                THEN
            THEN
        THEN
    THEN ;

' FIND $A006 ! \ re-vector FIND to use our FIND first

: test locals{ a b c } $BEEF set a  $FACE set b  $B00B set c 
  a $.  b $.  c $. $100 +SET c  c $. ;

: test ( a b c -- ) 
    locals{ a b c } set c  set b  set a
    cr ." a=" a .
    cr ." b=" b .
    cr ." c=" c . ;
1 2 3 test
